home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / errormsg.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.4 KB  |  83 lines

  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2.  
  3. structure ErrorMsg : ERRORMSG =
  4. struct
  5.  
  6.   open PrettyPrint Source
  7.  
  8.  (* error reporting *)
  9.  
  10.   exception Error  (* was Syntax, changed to Error in 0.92 *)
  11.  
  12.   datatype severity = WARN | COMPLAIN
  13.  
  14.   type complainer = severity -> string -> (ppstream -> unit) -> unit
  15.  
  16.   fun defaultConsumer () =
  17.       {consumer = System.Print.say,
  18.        linewidth = !System.Print.linewidth,
  19.        flush = System.Print.flush}
  20.  
  21.   val nullErrorBody = (fn (ppstrm: ppstream) => ())
  22.  
  23.   fun ppmsg(errConsumer,location,severity,msg,body) =
  24.       with_pp errConsumer (fn ppstrm =>
  25.     (begin_block ppstrm CONSISTENT 0;
  26.      begin_block ppstrm CONSISTENT 2;
  27.      add_string ppstrm location;
  28.      add_string ppstrm  (* print error label *)
  29.         (case severity
  30.            of WARN => " Warning: "
  31.         | COMPLAIN => " Error: ");
  32.      add_string ppstrm msg;
  33.      body ppstrm;
  34.          end_block ppstrm;
  35.      add_newline ppstrm;
  36.      end_block ppstrm))
  37.  
  38.   fun record(COMPLAIN,anyErrors) = anyErrors := true
  39.     | record(WARN,_) = ()
  40.  
  41.   fun location_string ({fileName,linePos,lineNum,...}:inputSource) (p1,p2) =
  42.       let fun look(p:int,a::rest,n) =
  43.         if a<p then (n,p-a) else look(p,rest,n-1)
  44.         | look _ = (0,0)
  45.       val (p1line,p1pos) = look(p1,!linePos,!lineNum)
  46.        in implode(Pathnames.trim fileName :: ":" :: makestring p1line :: "."
  47.           :: makestring p1pos
  48.           :: (if p1+1>=p2 then []
  49.               else let val (p2line,p2pos) = look(p2-1,!linePos,!lineNum)
  50.                 in ["-", makestring p2line, ".", makestring p2pos]
  51.                        end))
  52.       end
  53.  
  54.  
  55.   fun error (source as {anyErrors, errConsumer,...}: inputSource)
  56.             (p1:int,p2:int) (severity:severity)
  57.         (msg: string) (body : ppstream -> unit) = 
  58.       (ppmsg(errConsumer,(location_string source (p1,p2)),severity,msg,body);
  59.        record(severity,anyErrors))
  60.  
  61.   fun errorNoFile (errConsumer,anyErrors) ((p1,p2): region) severity msg body = 
  62.       (ppmsg(errConsumer,
  63.          if p2>0 then implode[makestring p1, "-", makestring p2] else "",
  64.          severity, msg, body);
  65.        record(severity,anyErrors))
  66.  
  67.   fun impossible msg =
  68.       (app System.Print.say ["Error: Compiler bug: ",msg,"\n"];
  69.        System.Print.flush();
  70.        raise Error)
  71.  
  72.   fun impossibleWithBody msg body =
  73.       (with_pp (defaultConsumer()) (fn ppstrm =>
  74.     (add_string ppstrm "Error: Compiler bug: ";
  75.      add_string ppstrm msg;
  76.      body ppstrm;
  77.      add_newline ppstrm));
  78.        raise Error)
  79.  
  80.   val matchErrorString = location_string
  81.  
  82. end  (* structure ErrorMsg *)
  83.